;;##########################################################################
;; toolmenu.lsp: 
;; dataobject and vista system methods for setting menu and tool states
;; Copyright (c) 1991-2002 by Forrest W. Young
;;##########################################################################

#|
As explained below (and also see file datatype.lsp)

The message (send $ :determine-data-type) reports the datatype (including generalized and expanded) and sets the extended-data-type and the data-type.

The message (send $ :data-type) reports/defines only the basic data types, not real, generalized and expanded. basic types are multivariate, classificaton, frequency, category, missing and matrix.

The entire set of (generalized) data types is:
univariate, bivariate, multivariate, category, class (or classification), freq, freqclass, crosstabs, table, matrix, new, missing, enabled, disabled, reenabled - (the table type is discontinued)

The corresponding set of data type abbreviations is
"UniVar" "BiVar" "MulVar" "Categ" "Class" "FrqTabl" "FrqCls" "General" "Table" "Matrix" "New" "Missing" "EnAbld" "DisAbld" "ReEnAbld" 

;The plugin-data-types (in systmob1)
;ANOVA  "class" "multivariate"
;CORESP "freq"           (future: "freq" "class" "category" "multivariate"?)
;MDSCAL "matrix"         (future: "matrix" "multivariate")
;MULREG "multivariate"
;PLUGIN "multivariate"   (future: "matrix" "multivariate")
;Regres "multivariate" "bivariate"
;Univar "multivariate" "univariate" "bivariate" "class"

;plugin-data-type multivariate includes univariate and bivariate everywhere
;except in determining menu and tool behavior

Using function (set-system-data-mode data-mode) is probably equivalent to 
using set-menu-item-states (see next), and only requires data-mode argument.

  (send *current-data* :set-menu&tool-states data-mode)
  (send *vista* :set-transformation-states data-mode)
  ;(send *vista* :set-analysis-states data-mode *current-data*)

using set-menu-item-states is most general and comprehensive since it uses set-transformation-states, :set-plot-and-view-item-states and :set-menu&tool-states, the later using all the remaining

:set-menu-item-states only used by setcd
   	it uses :set-transformation-states
		:set-transformation-states only used in this file by set-menu-item-states
	                it uses :set-menu&tool-states

:set-menu&tool-states used in dataobj0 dashobj2 dashobj4 and here
	it uses :set-analysis-states exclusively
			:set-analysis-states only used in this file by set-menu&tool-states
		it uses enable-menus exclusively
   			:enable-menus only used in this file by set-menu&tool-states

DATA TYPES: A string which can be:
multivariate, category, class, table, matrix, missing, enabled, reenabled or disabled
GENERALIZED DATA TYPES: 
divides multivariate into univariate, bivariate and multivariate, yielding:
(univariate, bivariate and multivariate) category, class, table, matrix, missing, enabled, reenabled or disabled
REAL DATA TYPES:
divides missing into new and missing, yielding:
(univariate, bivariate and multivariate) category, class, table, matrix, (new and missing), enabled, reenabled or disabled
EXTENDED DATA TYPES
divides class into class, freqclass and crosstabs, yielding:
(univariate, bivariate and multivariate) category, (class, freqclass and crosstabs), table, matrix, (new and missing), enabled, reenabled or disabled

so

univariate, bivariate, multivariate, category, class, freqclass, crosstabs, table, matrix, new, missing, enabled, reenabled or disabled

The message (send dob :determine-data-type) reports the datatype (including generalized and extended) and will set the extended-data-type and the data-type. (data-type includes only the basic data types, not real, generalized and extended). extended-data-type is a slot. Specifically, (send dob :determine-data-type) determines datatype using the following criteria, which are applied in order presented. First datatype where the criteria are satisfied is the assigned datatype (note that TABLE is no longer used):

 1) MISSING      >0 missing elements
 2) MATRIX       >0 matrices
 3) CATEGORY     >0 category variables, =0 numeric variables
 4) CROSSTABS    >0 category variables, >1 numeric variable, freq=t
 5) FREQ CLASS   >0 category variables, =1 numeric variable, freq=t
 6) CLASS        >0 category variables,(>1) numeric variable, freq=nil
 7) UNIVARIATE   =0 category variables, =1 numeric variable
 8) FREQTABLE    =0 category variables, >1 numeric variable, freq
 9) BIVARIATE    =0 category variables, =2 numeric variables
10) MULTIVARIATE =0 category variables, >2 numeric variables
________________________________________________________________ 
Number of  |       |                  Number of 
Category   | freq? |              Numeric Variables 
Variables  |       |     0          1          2         >2 
    0      | not-f |   error      univar     bivar     multvar
           |   f   |   error    freqtable  freqtable  freqtable 
   >0      | not-f |  category    class     (class)    (class)
           |   f   |  category  freqclass  crosstabs  crosstabs

The entire set of data types is:
univariate, bivariate, multivariate, general, category, class, classification, freq, freqclass, crosstabs, matrix, new, missing, enabled, disabled, reenable

The corresponding set of data type abbreviations is
"UniVar" "BiVar" "MulVar" "General" "Categ" "Class" "FrqTabl" "FrqCls" "XTabs" "Matrix" "New" "Missing" "EnAbld" "DisAbld" "ReEnAbl" 
|#

(defun set-system-data-mode (data-mode)
  (send *current-data* :set-menu&tool-states data-mode)
  (send *vista* :set-transformation-states data-mode)
  ;(send *vista* :set-analysis-states data-mode *current-data*)
  data-mode)

(defun data-type-abbreviation (datatype)  ;fwy changes 12182000
  (unless datatype (setf datatype (send current-data :data-type)))
     (let* ((data-table (list (list "univariate" "bivariate" "multivariate" "general"
                                    "category" "classification" "class" "freq" "freqclass"
                                    "crosstabs" "matrix" "new" "missing"  ;"table" removed
                                    "enabled"  "disabled" "reenabled")
                              (list "UniVar" "BiVar" "MulVar" "General"
                                    "Categ" "Class" "Class" "Frqncy" "FrqCls"
                                    "XTabs" "Matrix" "New" "Missing" ;"Table" 
                                    "EnAbld" "DisAbld" "ReEnAbl")))
            (abbrev (select (second data-table) 
                            (position (string-downcase datatype) 
                                      (first data-table) 
                                      :test #'equal)))
            )
       (unless abbrev 
               (one-button-dialog (format nil "Unknown DataType: ~a" datatype))
               (setf abbrev " [Nil] "))
     ; (if abbrev abbrev 
     ;      (setf abbrev 
     ;            (if datatype (select datatype (iseq (min 7 (length datatype)))) 
     ;                " [Nil] ")))
       abbrev))
       

;(trace :enable-menus :set-analysis-states 
;:set-transformation-states :reset-menu-states 
;:all-menu-items-on :set-menu&tool-states :set-menu-item-states )

;(trace data-type-abbreviation :set-menu-system :set-menu&tool-states 
;:set-menu-item-states :generalized-data-type)

(defmeth mv-data-object-proto :set-menu-system ()
"Args: None
Sets all aspects of the menu system, including menu items, menus and toolbar buttons, to reflect the current generalized data type of the current model. Uses set-menu-item-states."
  (let* ((menu-length (send self :menu-length))
         (current-icon) (ds-obj) (ds-open))
    (when (and (send self :iconify) menu-length)
          (setf current-icon (select (send *workmap* :data-icon-number-list)
                                (- menu-length 
                                   (send *workmap* :num-data-menu-items))))
          (setf ds-obj (send self :datasheet-object))
          (setf ds-open (current-datasheet-open))
          (send self :set-menu-item-states 
                menu-length menu-length current-icon ds-obj ds-open))))

(setf *stats-menus&tools-disabled* nil)

(defmeth mv-data-object-proto :set-menu&tool-states (data-mode)
"Method Args: data-mode
Sets all aspects of the menu system, including menu items, menus and toolbar buttons, to reflect the current generalized data type of the current model. Mode may be a string which is multivariate, category, class, table, matrix, MV, Enabled or Disabled." 
  (when (or (send *vista* :missing-values)
            (> (length (remove-duplicates 
                (list (send *vista* :menu-states) 
                      (send self :generalized-data-type) data-mode))) 1))
        (setf data-mode (string-downcase data-mode))
        (send *vista* :set-analysis-states data-mode self)
        (if (equal (string-downcase data-mode) "disabled") 
            (setf *stats-menus&tools-disabled* t)
            (setf *stats-menus&tools-disabled* nil))
        (if (member "category" 
                (map-elements #'string-downcase  
                              (send self :active-types '(all))) 
                :test #'equal)
            (send freq-tables-data-menu-item :enabled t)
            (send freq-tables-data-menu-item :enabled nil))
       ; (if (> (length (send self :active-variables '(category))) 1)
       ;     (send create-dob-data-menu-item :title "Convert Data Object ...")
       ;     (send create-dob-data-menu-item :title "Create Data Object"))
        ))
 
(defmeth mv-data-object-proto :set-menu-item-states 	 
              (menu-length current-item-number current-icon ds-obj ds-open)
"Sets menu states, analysis states, transformation states, menu item states, and toolbar button states using generalized-data-type"
  (initialize-desktop-window-menu t)
  (send self :set-menu&tool-states (send self :generalized-data-type))
  (send create-dob-data-menu-item :enabled t)
  (send delete-data-menu-item :enabled t)
  (send delete-model-menu-item :enabled nil)
  (send impute-missing-data-menu-item :enabled nil)
  (send summarize-data-menu-item :enabled t)
  (send report-data-menu-item :enabled t)
  (send new-data-file-menu-item :enabled t)
  (when *plots-menu* (send *plots-menu* :set-vista-menu-item-states self))
  (when *views-menu* (send *views-menu* :set-vista-menu-item-states self))
  (cond
    ((send *vista* :missing-values) 
     (send corr-trans-menu-item :enabled nil)
     (send covar-trans-menu-item :enabled nil)
     (send dist-trans-menu-item  :enabled nil)
     (send orth-trans-menu-item  :enabled nil))
    (t (send *vista* :set-transformation-states (send self :data-type))))
  (when (send *vista* :long-menus)
        (send (select (send *data-menu* :items) current-item-number) :mark t))
  (cond 
    ((send *vista* :missing-values)
     (send visualize-data-menu-item :enabled t);was nil PV
     (send summarize-data-menu-item :enabled t);was nil PV
     (send report-data-menu-item :enabled t);was nil PV
     (send impute-missing-data-menu-item :enabled t))
    ((send current-data :matrices)
     (send merge-vars-menu-item :enabled nil)
     (send merge-obs-menu-item :enabled nil)
     (send visualize-data-menu-item :enabled nil)
     (when previous-data (send merge-mats-menu-item :enabled t))
     (send *vista* :show-mats))
    (t
     (when previous-data 
           (send merge-vars-menu-item :enabled t)
           (send merge-obs-menu-item :enabled t))
     (send *vista*   :show-obs)
     (send merge-mats-menu-item    :enabled nil)
     (send visualize-data-menu-item :enabled t)))
  (if (member "category" 
                (map-elements #'string-downcase  
                              (send self :active-types '(all))) 
                :test #'equal)
      (send freq-tables-data-menu-item :enabled t)
      (send freq-tables-data-menu-item :enabled nil))
  )
  


;=======================;=======================
; VISTA SYSTEM OBJECT METHODS TO SET MENU STATES
;=======================;=======================

(defmeth vista-system-object-proto :set-menu-help-mode (&optional no-help-msg?)
  (send *vista* :show-help (not (send *vista* :show-help)))
  (send help-menu-menu-item-help-item :mark (send *vista* :show-help))
  (cond 
    ((send *vista* :show-help)
     (send self :all-menu-items-on)
     (unless no-help-msg?
             (file-to-window (strcat *help-path* "menuon.hlp") 
                             "Menu Item Help: Menu Help ON" *help-window*))
     (send self :help-cursors t))
    (t
     (send self :reset-menu-states)
     (send self :help-cursors nil)
     (unless no-help-msg?
             (file-to-window (strcat *help-dir-name* "menuoff.hlp") 
                             "Menu Item Help: Menu Help OFF" *help-window*)))))

(defmeth vista-system-object-proto :help-cursors (state)
  (cond
    (state
     (send *workmap* :cursor 'no-action)
     (when *datasheet* (send *datasheet* :cursor 'no-action))
    ; (when *fake-datasheet* (send *fake-datasheet* :cursor 'no-action))
     (send *obs-window* :cursor 'no-action)
     (send *var-window* :cursor 'no-action)
     (when *about-window* (send *about-window* :cursor 'no-action)))
    (t
     (send *workmap* :cursor 'arrow)
     (when *datasheet* (send *datasheet* :cursor 'arrow))
    ; (when *fake-datasheet* (send *fake-datasheet* :cursor 'arrow))
     (send *obs-window* :cursor 'arrow)
     (send *var-window* :cursor 'arrow)
     (when *about-window* (send *about-window* :cursor 'arrow)))))


(defmeth vista-system-object-proto :all-menu-items-on ()
  (send self :pre-menu-help-menu-item-states
        (mapcar #'(lambda (menu)
                    (mapcar #'(lambda (menu-item)
                                (send menu-item :enabled))
                            (send menu :items)))
                (list (if *ni* *vista-file-menu* *file-menu*) 
                      *command-menu* *data-menu* 
                      *trans-menu* *analyze-menu* *model-menu*)))
  (send self :pre-menu-help-menu-states
        (mapcar #'(lambda (menu)
                    (send menu :enabled))
                (list (if *ni* *vista-file-menu* *file-menu*) 
                      *command-menu* *data-menu* 
                      *trans-menu* *analyze-menu* *model-menu*)))
  (mapcar #'(lambda (menu)
              (send menu :enabled t)
              (mapcar #'(lambda (menu-item)
                          (send menu-item :enabled t))
                      (send menu :items)))
          (list (if *ni* *vista-file-menu* *file-menu*) 
                *command-menu* *data-menu* 
                *trans-menu* *analyze-menu* *model-menu*))
  (send *edit-menu* :enabled nil)
  (when *devel-menu* (send *devel-menu* :enabled nil))
  )


(defmeth vista-system-object-proto :stats-menus-off ()
  (mapcar #'(lambda (menu)
              (send menu :enabled nil))
          (list *data-menu* *trans-menu* *graphics-menu* *analyze-menu* *model-menu*)))

(defmeth vista-system-object-proto :stats-menus-on ()
  (mapcar #'(lambda (menu)
              (send menu :enabled t))
          (list *data-menu* *trans-menu* *graphics-menu* *analyze-menu*)))

(defmeth vista-system-object-proto :reset-menu-states ()
  (mapcar #'(lambda (menu menu-state menu-item-states)
              (send menu :enabled menu-state)
              (mapcar #'(lambda (menu-item original-state)
                          (send menu-item :enabled original-state))
                      (send menu :items) menu-item-states))
          (list (if *ni* *vista-file-menu* *file-menu*) 
                *command-menu* *data-menu* 
                *trans-menu* *analyze-menu* *model-menu*)
          (send self :pre-menu-help-menu-states)
          (send self :pre-menu-help-menu-item-states))
  (send *edit-menu* :enabled t)
  (when *devel-menu* (send *devel-menu* :enabled t)))

(defmeth vista-system-object-proto :set-analysis-states (data-mode data-obj)
"Method Args: data-mode data-obj
Sets states of menu items and toolbar tools to gray or normal depending on generalized-data-mode. The generalized mode depends on the data-mode, which may be a string which is multivariate, category, class, table, matrix, missing, enabled, reenabled or disabled. In addition, when the data-mode is multivariate, the generalized data-mode subdivides the mode into univariate, bivariate or multivariate. Thurs, there are 11 analysis states." 
  (let* ((ok-data-types (send self :plugin-data-types)) ;send self ok-data-types
         (menu-items (send *vista* :remove-dash-menu-items *analyze-menu*))
         (num-icons-shown (send *toolbar* :num-icons-shown))
         (tool-items (select (send *toolbar* :items) (iseq num-icons-shown)))
         (tool-data-types (select (send *toolbar* :data-types-list) (iseq num-icons-shown)))
         (draw t)
         )
    (when (or (not (send *workmap* :gui)) 
              (not (send *workmap* :toolbar)))
          (setf draw nil))
    (when (equal data-mode "reenable") 
          (setf data-mode (send self :menu-states)))

    (cond 
      ((or (equal data-mode "disabled") 
           (equal data-mode "enabled")
           ;(equal data-mode "missing")
           )
       (mapcar #'(lambda (tool) 
                   (when (not (equal (send tool :state) data-mode))
                         (send tool :enabled (equal data-mode "enabled")
                               :draw draw)
                         ))
               tool-items)
       (mapcar #'(lambda (item) 
                   (send item :enabled (equal data-mode "enabled") )) 
               menu-items))
      (t
       (setf generalized-data-mode (send data-obj :generalized-data-type))
       (mapcar #'(lambda (ok-data tool)
                   (when (not (equal (send tool :state) data-mode))
                         (send tool :enabled 
                               (member generalized-data-mode ok-data :test #'equal)
                               :draw draw)
                         ))
               tool-data-types tool-items)
       (mapcar #'(lambda (ok-data menu) 
                   (send menu :enabled 
				(member generalized-data-mode ok-data :test #'equal)))
               ok-data-types menu-items)))
    (send self :menu-states data-mode)
    (cond 
      ((equal data-mode "missing") 
       (send *toolbox* :set-two-buttons nil nil)
       (send self :enable-menus t t nil nil))
      ((equal data-mode "disabled") 
       (send *toolbox* :set-two-buttons nil nil)
       (send self :enable-menus nil nil nil nil))
      ((equal data-mode "matrix")
       (send *toolbox* :set-two-buttons t nil)
       (send self :enable-menus t nil t (if *current-model* t nil)))
      (t
       (send *toolbox* :set-two-buttons t (not (equal data-mode "matrix")))
       (send self :enable-menus t t t (if *current-model* t nil))))
    ))

(defmeth vista-system-object-proto :set-transformation-states (data-mode)
;multivariate, category, classification, table, matrix, MV, Enabled or Disabled
    (mapcar #'(lambda (item) (send item :enabled t))
               (send *trans-menu* :items))
    (cond 
      ((equal data-mode "category")
       (mapcar #'(lambda (item) (send item :enabled nil))
               (send *trans-menu* :items))
      ; (mapcar #'(lambda (item) (send item :enabled t))
      ;         (select (send *trans-menu* :items) 
      ;                  (list 0 20 23 25 26)))
       (mapcar #'(lambda (item) (send item :enabled t))
               (list sort-trans-menu-item edit-variables-menu-item
                     dummycode-trans-menu-item split-trans-menu-item 
                     join-trans-menu-item))
       )
      ;sort-trans-menu-item
      ((equal data-mode "class")
       (send freq-tables-data-menu-item :enabled t)
      ; (mapcar #'(lambda (item) (send item :enabled nil))
      ;         (select (send *trans-menu* :items)
      ;                (list 12 13 14 17 18)))
       (mapcar #'(lambda (item) (send item :enabled nil))
               (list sort-trans-menu-item rank-trans-menu-item
                     nscores-trans-menu-item absval-trans-menu-item
                     exponent-trans-menu-item logarithm-trans-menu-item
                     round-trans-menu-item trnsps-trans-menu-item
                     orth-trans-menu-item corr-trans-menu-item )))))
                             
    

(defmeth vista-system-object-proto :enable-menus (dm tm am mm)
  (when (not (equal (send *data-menu* :enabled) dm)) 
        (send *data-menu*  :enabled dm)) 
  (when (not (equal (send *graphics-menu* :enabled) dm)) 
        (send *graphics-menu*  :enabled dm)) 
  (when (not (equal (send *trans-menu* :enabled) tm)) 
        (send *trans-menu*  :enabled tm))
  (when (not (equal (send *tools-menu* :enabled) am)) 
        (send *tools-menu*  :enabled am))
  (when *current-model*
        (when (not (equal (send *model-menu* :enabled) mm)) 
              (send *model-menu*  :enabled mm))))